;;;; -*- Mode: Lisp; Package: :dreaming-tree -*-
;;;;
;;;; Class definitions for scene objects and renderers

(in-package :dreaming-tree)

#-xlui (defparameter *reference-id-counter* 0)

(defclass named-object (xml-serializer)
  ((name         :accessor name         :initform nil                           :initarg :name)
   (reference-id :accessor reference-id :initform (incf *Reference-Id-Counter*) :type    integer)))

(defun default-object-name (obj)
  (format nil "OBJECT-~A" (reference-id obj)))

(defmethod initialize-instance :after ((obj named-object) &rest initargs)
  (declare (ignore initargs))
  (when (null (name obj))
    (setf (name obj) (default-object-name obj))))

(defmethod print-object ((obj named-object) stream)
  (print-unreadable-object (obj stream :type t :identity t)
    (format stream "~A" (name obj))))

;;;; Scene Management
(defclass spatial (named-object)
  ((controllers        :accessor controllers        :initarg :controller         :initform nil)
   (culled-p           :accessor culled-p           :initarg :culled-p           :initform nil)
   (transformation     :accessor transformation     :initarg :transformation     :initform (make-transform)
		       :type transform)
   (bv                 :accessor bounding-volume    :initarg :bounding-volume    :initform (make-bound))
   (bound-is-current-p :accessor bound-is-current-p :initarg :bound-is-current-p :initform nil)
   (view               :accessor view               :initarg :view)
   (parent             :accessor parent             :initarg :parent             :initform nil)
   (intervals :accessor intervals :initarg :extremum :initform nil)))

(defgeneric center (object))
(defgeneric initialize-data (spatial renderer)
  (:documentation "This method is called when a spatial is first associated with a rendering context."))

;; Render State Updates
(defgeneric update-render-state (spatial state-stack light-stack)
  (:documentation "Entry point of performaing a render state update on the scene graph via
a depth first traversal."))
(defgeneric propagate-state-from-root (spatial state-stack light-stack)
  (:documentation ""))
(defgeneric push-state (spatial state-stack light-stack)
  (:documentation "Push global states and lights attached to this spatial on to the global
state stack."))
(defgeneric pop-state (spatial state-stack light-stack))
(defgeneric update-state (spatial state-stack light-stack)
  (:documentation "Called at leaf nodes in the scene graph to copy 'active' global states into
local storage."))

(defclass node (spatial)
  ((children :accessor children :initarg :children :initform nil)))

(defgeneric insert-object (object-spec node))
(defgeneric delete-object (object-spec node))
(defgeneric find-object (object-spec node))
(defgeneric determine-visible-set (node culler))
(defgeneric determine-intersecting-set (node))
(defgeneric geometric-update-pass (node))

(defclass r-tree (node)
  ((max-children :accessor max-children :initarg :max-children :initform 6)
   (min-children :accessor min-children :initarg :min-children :initform 2)
   (i_x :accessor child-x-intervals :initarg :x-intervals :initform nil)
   (i_y :accessor child-y-intervals :initarg :y-intervals :initform nil)
   (i_z :accessor child-z-intervals :initarg :z-intervals :initform nil)))

(defclass geometry (spatial)
  ((v    :accessor vertices  :initarg  :vertices)
   (c    :accessor colors    :initarg  :colors :initform nil)
   (n    :accessor normals   :initarg  :normals :initform nil)
   (i    :accessor indices   :initarg  :indices)
   (tc   :accessor texcoords :initarg  :texcoords :initform nil)
   (vao-format :accessor vertex-attrib-object-format :initarg :vao-format :initform nil)
   (vao :accessor vertex-attrib-object :initarg :vao :initform nil)))

(defclass cube (geometry)
  ((texture :accessor cube-texture :initarg :texture :initform nil)
   (color   :accessor cube-color   :initarg :color   :initform #(1.0 1.0 1.0 1.0))))


(defclass trimesh (geometry)
  ())

(defgeneric vertex-count (trimesh))
(defgeneric get-vertex (trimesh idx))
(defgeneric triangle-count (trimesh))
(defgeneric get-triangle (trimesh idx))

;;;;

(defclass effect (xml-serializer)
  ((tex :accessor texture :initarg :texture)))

;;;;

(defclass basic-culler (xml-serializer)
  ((camera :accessor culling-camera :initarg :camera)
   (frustum :accessor culling-frustum :initarg :frustum)
   (planes :accessor culling-planes :initform '())
   (states :accessor culling-plane-states :initform '())
   (visible :accessor visible-set :initform nil)))

(defgeneric update-frustum (culler))
(defgeneric compute-visible-set (culler scene))
(defgeneric on-determined-visible (spatial))
(defgeneric visible-p (culler object))

;;;;
(defclass scene-manager (named-object)
  ((world-axis :accessor scene-world-axis :initarg :world-axis :initform (identity-matrix 3)
               :documentation "3x3 matrix that represents the reference frame for world coordinates.  
Column 0 is the view direction, column 1 the up direction, and column 2 the right
direction.")
   (root :accessor scene-root :initarg :root :initform nil)
   (free-camera-move-p :accessor free-camera-move-p :initarg :free-camera-move-p :initform t)
   (culler :accessor scene-culler :initarg :culler :initform (make-instance 'basic-culler))
   (camera :accessor scene-camera :initarg :camera :initform nil)
   (culler-update-p :accessor culler-update-p :initarg :culler-update-p :initform nil)
   (object-moved-p :accessor object-moved-p :initarg :object-moved-p :initform nil)))

(defgeneric insert-object (scene object))
(defgeneric find-object (scene object-ref))
(defgeneric update-object (scene object-ref new-transform))
(defgeneric delete-object (scene object))
(defgeneric determine-visible-set (scene))
;; Camera motion, some of these functions are redundant.
(defgeneric move-forward (scene &optional speed))
(defgeneric move-back (scene &optional speed))
(defgeneric pan-left (scene &optional speed))
(defgeneric pan-right (scene &optional speed))
(defgeneric pan-up (scene &optional speed))
(defgeneric pan-down (scene &optional speed))
(defgeneric turn-left (scene &optional speed))
(defgeneric turn-right (scene &optional speed))
(defgeneric look-up (scene &optional speed))
(defgeneric look-down (scene &optional speed))
(defgeneric turn-camera (scene rot-x rot-y &optional move-speed))
(defgeneric pan-camera (scene dx dy &optional move-speed))
(defgeneric zoom-camera (scene dz &optional zoom-speed))

;; Probably should be subclass of named-object
(defclass renderer (named-object)
  ((current-key-event :accessor current-key-event :initarg :current-key-event :initform nil)
   (scene :accessor renderer-scene :initarg :scene)
   (textures :accessor textures :initarg :textures :initform (make-hash-table))
   (current-timestep :accessor current-timestep :initform 0.0)
   (current-time :accessor current-time :initform 0.0)
   (gl-version-string :reader gl-version-string)
   (gl-major-version :reader gl-major-version)
   (gl-minor-version :reader gl-minor-version)
   (extensions :reader gl-extensions)
   (vendor :reader gl-vendor)
   (renderer :reader gl-renderer)
   (type-safety-p :accessor type-safety-p :initform t :initarg :type-safety-p)
   (compiled-shaders :accessor compiled-shaders :initform (make-hash-table))
   (linked-shaders :accessor linked-shaders :initform (make-hash-table))))

(defgeneric application-time (renderer))
(defgeneric init (canvas-view)
  (:documentation "Chance to initialize OpenGL context."))
(defgeneric clear-background (renderer)
  (:documentation "Called before drawing a scene to clear the contents of the framebuffer."))
(defgeneric draw-scene (renderer objects)
  (:documentation "Draw the scene as defined by the contents of the objects argument."))
(defgeneric on-idle (renderer)
  (:documentation "This function is (should be) called after every glFlush, i.e. between screen updates."))
(defgeneric scene-cleanup (renderer)
  (:documentation "Called when window view is kept in is about to close."))
(defgeneric start-animation (renderer)
  (:documentation ""))
(defgeneric stop-animation (renderer)
  (:documentation ""))


;;;; Controllers

(defclass controller (xml-serializer)
  ())

(defclass spin-controller (controller)
  ((rx :accessor spin-rate-x :initarg :spin-rate-x :initform 0.0)
   (ry :accessor spin-rate-y :initarg :spin-rate-y :initform 0.0)
   (rz :accessor spin-rate-z :initarg :spin-rate-z :initform 0.0)))

(defgeneric update-controllers (controllers spatial dt app-time))


;;;; Render States

(defclass global-render-state (xml-serializer)
  ((enabled-p :accessor enabled-p :initarg :enabled-p :initform nil)))

;;;; Physics and Collisions

;; Slots are named to be consistent with Chapter 5 of "Game Physics",
;; but accessors have more descriptive names to describe their function.
(defclass rigid-body (trimesh)
  ((m           :accessor mass :initarg :mass :initform 1.0)
   (elasticity  :accessor elasticity :initarg :elasticity :documentation "Elasticity, or coefficient of restitution.")
   (minv        :accessor mass-inv :initarg :mass-inv :documentation "Inverse mass.")
   (inertia     :accessor body-inertia :initarg :body-inertia :initform (identity-matrix 3)
		:type array
                :documentation "Inertia tensor in body coordinates.")
   (inertia-inv :accessor body-inertia-inv :initarg :body-inertia-inv
		:type array
                :documentation "Inverse of the inertia tensor.")
   (p           :accessor linear-momentum :initarg :linear-momentum :initform (zero-vector 3)
		:type vector
                :documentation "Vector representing the linear momentum of the body.")
   (l           :accessor angular-momentum :initarg :angular-momentum :initform (zero-vector 3)
		:type vector
                :documentation "Vector representing the angular momentum of the rigid body.")
   (r           :reader orientation-matrix :initform (zero-matrix 3)
		:type array
                :documentation "Cached value of the orientation matrix.")
   (vel         :reader linear-velocity :initform (zero-vector 3)
		:type vector
                :documentation "Cached value of the object's linear velocity vector.")
   (w           :reader angular-velocity :initform (zero-vector 3)
		:type vector
                :documentation "Cached value of the object's angular velocity vector.")
   (iforces     :accessor internal-forces :initarg :internal-forces :initform (zero-vector 3))
   (eforces     :accessor external-forces :initarg :external-forces :initform (zero-vector 3))
   (force       :accessor force :initarg :force :initform nil
                :documentation "Function that represents current forces acting on body.")
   (torque      :accessor torque :initarg :torque :initform nil
                :documentation "Function that represents current torques acting on body.")))

(defgeneric mass-center (rigid-body)
  (:documentation "Returns a vector representing the center of mass
  for the rigid body based on the world transformation for the
  object"))
(defgeneric orientation (rigid-body)
  (:documentation "Orientation, q = (w, x, y, z)"))

(defclass force ()
  ())

(defclass torque ()
  ())

;;; Shapes & Other Geometric Primitives

(defclass plane (trimesh)
  ((p :accessor point :initarg :point :type vector)
   (pn :accessor plane-normal :initarg :plane-normal :type vector)))

(defclass line (trimesh) ;; Now that doesn't make much sense, does it?
  ((p :accessor point :initarg :point :type vector)
   (d :accessor direction :initarg :direction :type vector)))

(defclass ray (line)
  ())

(defclass segment (line)
  ((e :accessor extent :initarg :extent)))

;; Triangles are parameterized by T(s,t)=B+s*E0+t*E1.
(defclass triangle (trimesh)
  ((b :accessor base :initarg :base)
   (e0 :accessor extent0 :initarg :extent0)
   (e1 :accessor extent1 :initarg :extent1)))

(defclass circle (trimesh)
  ((c :accessor center :initarg :center)
   (r :accessor radius :initarg :radius)))

(defclass sphere (circle)
  ())
